home *** CD-ROM | disk | FTP | other *** search
/ Hardcore Visual Basic 5.0 (2nd Edition) / Hardcore Visual Basic 5.0 - Second Edition (1997)(Microsoft Press).iso / Code / SieveP.ctl < prev    next >
Text File  |  1997-06-14  |  3KB  |  131 lines
  1. VERSION 5.00
  2. Begin VB.UserControl XSieveP 
  3.    BorderStyle     =   1  'Fixed Single
  4.    ClientHeight    =   645
  5.    ClientLeft      =   0
  6.    ClientTop       =   0
  7.    ClientWidth     =   645
  8.    BeginProperty Font 
  9.       Name            =   "Tahoma"
  10.       Size            =   7.5
  11.       Charset         =   0
  12.       Weight          =   700
  13.       Underline       =   0   'False
  14.       Italic          =   0   'False
  15.       Strikethrough   =   0   'False
  16.    EndProperty
  17.    ScaleHeight     =   645
  18.    ScaleWidth      =   645
  19.    ToolboxBitmap   =   "SieveP.ctx":0000
  20.    Begin VB.Label lbl 
  21.       Caption         =   "Sieve"
  22.       Height          =   204
  23.       Left            =   36
  24.       TabIndex        =   0
  25.       Top             =   24
  26.       Width           =   540
  27.    End
  28.    Begin VB.Image img 
  29.       Height          =   225
  30.       Left            =   45
  31.       Picture         =   "SieveP.ctx":00FA
  32.       Top             =   255
  33.       Width           =   240
  34.    End
  35. End
  36. Attribute VB_Name = "XSieveP"
  37. Attribute VB_GlobalNameSpace = False
  38. Attribute VB_Creatable = True
  39. Attribute VB_PredeclaredId = False
  40. Attribute VB_Exposed = True
  41. Option Explicit
  42.  
  43. Private af() As Boolean, iCur As Integer
  44. Private iMaxPrime As Integer, cPrime As Integer
  45.  
  46. ' Initialize Properties for User Control
  47. Private Sub UserControl_InitProperties()
  48.     ' Default size is largest integer
  49.     iMaxPrime = 32766
  50. End Sub
  51.  
  52. ' Load property values from storage
  53. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  54.     iMaxPrime = PropBag.ReadProperty("MaxPrime", 32766)
  55. End Sub
  56.  
  57. ' Write property values to storage
  58. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  59.     Call PropBag.WriteProperty("MaxPrime", iMaxPrime, 32766)
  60. End Sub
  61.  
  62. Private Sub UserControl_Show()
  63.     ReInitialize
  64.     If Ambient.UserMode Then Extender.Visible = False
  65. End Sub
  66.  
  67. Private Sub UserControl_Resize()
  68.     Width = lbl.Width
  69.     Height = lbl.Width
  70. End Sub
  71.  
  72. Sub ReInitialize()
  73.     ReDim af(0 To iMaxPrime)
  74.     iCur = 1: cPrime = 0
  75. End Sub
  76.  
  77. Property Get NextPrime() As Integer
  78. Attribute NextPrime.VB_MemberFlags = "400"
  79.     NextPrime = 0
  80.     ' Loop until we find a prime or overflow array
  81.     iCur = iCur + 1
  82.     On Error GoTo OverMaxPrime
  83.     Do While af(iCur)
  84.         iCur = iCur + 1
  85.     Loop
  86.     ' Cancel multiples of this prime
  87.     Dim i As Long
  88.     For i = iCur + iCur To iMaxPrime Step iCur
  89.         af(i) = True
  90.     Next
  91.     ' Count and return it
  92.     cPrime = cPrime + 1
  93.     NextPrime = iCur
  94. OverMaxPrime:       ' Array overflow comes here
  95. End Property
  96.  
  97. Property Get MaxPrime() As Integer
  98.     MaxPrime = iMaxPrime
  99. End Property
  100.  
  101. Property Let MaxPrime(iMaxPrimeA As Integer)
  102.     iMaxPrime = iMaxPrimeA
  103.     ReInitialize
  104.     PropertyChanged "MaxPrime"
  105. End Property
  106.  
  107. Property Get Primes() As Integer
  108. Attribute Primes.VB_MemberFlags = "400"
  109.     Primes = cPrime
  110. End Property
  111.  
  112. Sub AllPrimes(ai() As Integer)
  113.     If LBound(ai) <> 0 Then Exit Sub
  114.     iMaxPrime = UBound(ai)
  115.     cPrime = 0
  116.     Dim i As Integer
  117.     For iCur = 2 To iMaxPrime
  118.         If Not af(iCur) Then    ' Found a prime
  119.             For i = iCur + iCur To iMaxPrime Step iCur
  120.                 af(i) = True    ' Cancel its multiples
  121.             Next
  122.             ai(cPrime) = iCur
  123.             cPrime = cPrime + 1
  124.         End If
  125.     Next
  126.     ReDim Preserve ai(0 To cPrime) As Integer
  127.     iCur = 1
  128. End Sub
  129.  
  130.  
  131.